home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 24 / Amiga Format AFCD24 (Feb 1998, Issue 108).iso / -in_the_mag- / emulation / amiga / uae-0.7.0b2 / uae-ui.tk < prev    next >
Text File  |  1998-01-20  |  12KB  |  314 lines
  1. set Program(Name)    "UAE Control"
  2. set Program(Version) "0.6.8"
  3.  
  4.  
  5. wm title      . "$Program(Name)"
  6. wm iconname   . "$Program(Name)"
  7. wm grid       . 1 1 1 1
  8.  
  9.     set amiga [image create bitmap -data "#define amiga_width 60
  10. #define amiga_height 24
  11. static unsigned char amiga_bits[] = {
  12.   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  13.   0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x0f, 0x00, 0x00, 0x00,
  14.   0x00, 0x00, 0x00, 0xc0, 0x0f, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xe1,
  15.   0xcf, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0xf0, 0xcf, 0xff, 0xff, 0x01,
  16.   0x00, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xbc,
  17.   0x0f, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x3f, 0x9e, 0xcf, 0xff, 0xff, 0x01,
  18.   0xf8, 0xff, 0x1f, 0x8f, 0xcf, 0xff, 0xff, 0x01, 0x00, 0x00, 0x80, 0x87,
  19.   0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x83, 0x0f, 0x00, 0x00, 0x00,
  20.   0xf8, 0xff, 0xe3, 0x81, 0xcf, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xf1, 0x80,
  21.   0xcf, 0xff, 0xff, 0x01, 0x00, 0x00, 0x78, 0x80, 0x0f, 0x00, 0x00, 0x00,
  22.   0x00, 0x00, 0xfc, 0xff, 0x0f, 0x00, 0x00, 0x00, 0xf8, 0x3f, 0xfe, 0xff,
  23.   0xcf, 0xff, 0xff, 0x01, 0xf8, 0x1f, 0xff, 0xff, 0xcf, 0xff, 0xff, 0x01,
  24.   0x00, 0x80, 0x07, 0x80, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x80,
  25.   0x0f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x80, 0x0f, 0x00, 0x00, 0x00,
  26.   0x00, 0xf8, 0x07, 0xc0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xc0,
  27.   0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  28.   };"]
  29.  
  30.     set tip [image create bitmap -data "#define tip_width 44
  31. #define tip_height 16
  32. static unsigned char tip_bits[] = {
  33.   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  34.   0x00, 0x00, 0x00, 0xc0, 0xf3, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x79, 0x00,
  35.   0x00, 0x00, 0x00, 0xf0, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x78, 0x1e, 0x00,
  36.   0x00, 0x00, 0x00, 0x3c, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x9e, 0x07, 0x00,
  37.   0x00, 0x1c, 0x07, 0xcf, 0x03, 0x00, 0x00, 0x3c, 0x8f, 0xe7, 0x01, 0x00,
  38.   0x00, 0x78, 0xde, 0xf3, 0x00, 0x00, 0x00, 0xf0, 0xfc, 0x79, 0x00, 0x00,
  39.   0x00, 0xe0, 0xf9, 0x3c, 0x00, 0x00, 0x00, 0xc0, 0x73, 0x1e, 0x00, 0x00,
  40.   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  41.   };"]
  42.  
  43.  
  44.     set disk0 [image create bitmap -data "#define disk0_width 35
  45. #define disk0_height 17
  46. static unsigned char disk0_bits[] = {
  47.   0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  48.   0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  49.   0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  50.   0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  51.   0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x05, 0x80, 0x07,
  52.   0x0f, 0x80, 0x05, 0x80, 0x07, 0x0f, 0x80, 0x05, 0x80, 0x07, 0x0f, 0x80,
  53.   0x05, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  54.   0x07, };"]
  55.  
  56. set disk1 [image create bitmap -data "#define disk1_width 35
  57. #define disk1_height 17
  58. static unsigned char disk1_bits[] = {
  59.   0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  60.   0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  61.   0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  62.   0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  63.   0x80, 0x07, 0x0f, 0x00, 0x02, 0x80, 0x07, 0x0f, 0x80, 0x03, 0x80, 0x07,
  64.   0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00,
  65.   0x03, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  66.   0x07, };"]
  67.  
  68. set disk2 [image create bitmap -data "#define disk2_width 35
  69. #define disk2_height 17
  70. static unsigned char disk2_bits[] = {
  71.   0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  72.   0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  73.   0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  74.   0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  75.   0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x06, 0x80, 0x07,
  76.   0x0f, 0x00, 0x06, 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80,
  77.   0x01, 0x80, 0x07, 0x09, 0x80, 0x07, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  78.   0x07, };"]
  79.  
  80. set disk3 [image create bitmap -data "#define disk3_width 35
  81. #define disk3_height 17
  82. static unsigned char disk3_bits[] = {
  83.   0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  84.   0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  85.   0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  86.   0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  87.   0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x06, 0x80, 0x07,
  88.   0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x06, 0x80, 0x07, 0x0f, 0x80,
  89.   0x06, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  90.   0x07, };"]
  91.  
  92.  
  93.  
  94. proc Bye {} {
  95.   global outpipe
  96.   puts $outpipe "bye"
  97.   flush $outpipe
  98.   close $outpipe
  99.   exit
  100. }
  101.  
  102. proc Eject {num} {
  103.     global outpipe
  104.     puts $outpipe "eject"
  105.     puts $outpipe "$num"
  106.     flush $outpipe
  107. }
  108.  
  109. proc Nuke {} {
  110.     global outpipe
  111.     puts $outpipe "reset"
  112.     flush $outpipe
  113. }
  114.  
  115. proc Dbug {} {
  116.     global outpipe
  117.     puts $outpipe "debug"
  118.     flush $outpipe
  119. }
  120.  
  121.  
  122. proc readdata {} {
  123.   global inpipe
  124.   global file0
  125.   global file1
  126.   global file2
  127.   global file3
  128.  
  129.   set command [gets $inpipe]
  130.  
  131.   if {[string compare $command "power 0"] == 0} {
  132.     .brs.powerled config -bg #000000000000
  133.   } elseif {[string compare $command "power 1"] == 0} {
  134.     .brs.powerled config -bg #ffff00000000
  135.   } elseif {[string compare $command "driveled 1"] == 0} {
  136.     set command [gets $inpipe]
  137.     .drives.x$command.led config -bg #ffffffff0000
  138.   } elseif {[string compare $command "driveled 0"] == 0} {
  139.     set command [gets $inpipe]
  140.     .drives.x$command.led config -bg #000000000000
  141.   } elseif {[string compare $command "drivename"] == 0} {
  142.     set number [gets $inpipe]
  143.     set file$number [gets $inpipe]
  144.   } 
  145. }
  146.  
  147. proc OpenPipes {} {
  148.   global env
  149.   global outpipe
  150.   global inpipe
  151.   set args $env(ARGS)
  152.  
  153.   if {[llength $args] != 2} {
  154.       exit
  155.   }
  156.   set outpipe [open [lindex $args 0] "w"]
  157.   set inpipe [open [lindex $args 1] "r"]
  158.   puts $outpipe "Startup"
  159.   flush $outpipe
  160. }
  161.  
  162. frame .drives -relief raised -borderwidth 2 -bg #cccccccccccc
  163.     label .drives.title -text "Floppy drives" -bg #cccccccccccc
  164.     frame .drives.x3 -relief sunken -borderwidth 2 -bg #cccccccccccc
  165.     button .drives.x3.insert -relief groove -image $disk3 -command {File 3}
  166.     frame .drives.x3.f
  167.     label .drives.x3.f.file -width 35 -relief groove -textvariable file3
  168.     button .drives.x3.eject -image $tip -relief groove -command {Eject 3} -bg #cccccccccccc
  169.  
  170.     frame .drives.x3.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
  171.     pack .drives.x3 -side bottom -expand yes -fill both 
  172.     pack .drives.x3.insert -side left
  173.     pack .drives.x3.f -side left
  174.     pack .drives.x3.f.file -side left
  175.     pack .drives.x3.led -side right
  176.     pack .drives.x3.eject -side right
  177.  
  178.     frame .drives.x2 -relief sunken -borderwidth 2 -bg #cccccccccccc
  179.     button .drives.x2.insert -relief groove -image $disk2 -command {File 2}
  180.     frame .drives.x2.f
  181.     label .drives.x2.f.file -width 35 -relief groove -textvariable file2 
  182.     button .drives.x2.eject -image $tip -relief groove -command {Eject 2} -bg #cccccccccccc
  183.     frame .drives.x2.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
  184.     pack .drives.x2 -side bottom -expand yes -fill both 
  185.     pack .drives.x2.insert -side left
  186.     pack .drives.x2.f -side left
  187.     pack .drives.x2.f.file -side left
  188.     pack .drives.x2.led -side right
  189.     pack .drives.x2.eject -side right
  190.  
  191.     frame .drives.x1 -relief sunken -borderwidth 2 -bg #cccccccccccc
  192.     button .drives.x1.insert -relief groove -image $disk1 -command {File 1}
  193.     frame .drives.x1.f
  194.     label .drives.x1.f.file -width 35 -relief groove -textvariable file1
  195.     button .drives.x1.eject -image $tip -relief groove -command {Eject 1} -bg #cccccccccccc
  196.     frame .drives.x1.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
  197.     pack .drives.x1 -side bottom -expand yes -fill both 
  198.     pack .drives.x1.insert -side left
  199.     pack .drives.x1.f -side left
  200.     pack .drives.x1.f.file -side left
  201.     pack .drives.x1.led -side right
  202.     pack .drives.x1.eject -side right
  203.  
  204.  
  205.     frame .drives.x0 -relief sunken -borderwidth 2 -bg #cccccccccccc
  206.     button .drives.x0.insert -relief groove -image $disk0 -command {File 0}
  207.     frame .drives.x0.f 
  208.     label .drives.x0.f.file -width 35 -relief groove -textvariable file0
  209.     button .drives.x0.eject -image $tip -relief groove -command {Eject 0} -bg #cccccccccccc
  210.     frame .drives.x0.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
  211.     pack .drives.x0 -side bottom -expand yes -fill both 
  212.     pack .drives.x0.insert -side left
  213.     pack .drives.x0.f -side left
  214.     pack .drives.x0.f.file -side left
  215.     pack .drives.x0.led -side right
  216.     pack .drives.x0.eject -side right     
  217.     pack .drives.title -side top
  218.  
  219.  
  220.   frame .brs -relief raised -borderwidth 2 -bg #cccccccccccc
  221.   label .brs.amiga -image $amiga -bg #cccccccccccc
  222.   frame .brs.powerled -width 1c -height .3c -relief groove -borderwidth 2 -background #ffff00000000
  223.   button .brs.reset -text "Hard reset" -relief groove -command { Nuke } -bg #cccccccccccc
  224.   button .brs.debug -text "Debug" -relief groove -command { Dbug } -bg #cccccccccccc
  225.   button .brs.quit -text "Exit" -relief groove -command { Bye } -bg #cccccccccccc
  226.   pack .brs.amiga -side left
  227.   pack .brs.reset -side left
  228.   pack .brs.debug -side left
  229.   pack .brs.quit -side left
  230.   pack .brs.powerled -side right
  231.  
  232. pack .drives -side bottom -fill x
  233. pack .brs -side bottom -fill x
  234. .brs.powerled config -bg #000000000000
  235. OpenPipes
  236. fileevent $inpipe readable {readdata}
  237.  
  238.  
  239. proc loadDir w {
  240.     global dirName
  241.  
  242.     $w.f.list delete 0 end
  243.     foreach i [lsort [glob $dirName/*]] {
  244.     $w.f.list insert end [file tail $i]
  245.     }
  246. }
  247.  
  248. # loadImage --
  249. # Given the name of the toplevel window of the demo and the mouse
  250. # position, extracts the directory entry under the mouse and loads
  251. # that file into a photo image for display.
  252. #
  253. # Arguments:
  254. # w -            Name of the toplevel window of the demo.
  255. # x, y-            Mouse position within the listbox.
  256.  
  257.  
  258. proc loadFile {w x y num} {
  259.     global dirName
  260.     global outpipe
  261.     global inpipe
  262.  
  263.     puts $outpipe "insert"
  264.     puts $outpipe "$num"
  265.  
  266.     flush $outpipe
  267.  
  268.     set isok [gets $inpipe]
  269.     if {[string compare $isok "ok"] == 0} {
  270.     set file $dirName/[$w.f.list get @$x,$y]
  271.  
  272.     puts $outpipe $file
  273.     flush $outpipe    
  274.     destroy 
  275.     } else {
  276.       tk_dialog .foo {UAE Disk Error} {You must use Eject first!} {} 0 OK 
  277.     }
  278. }
  279.  
  280. proc File {drive} {
  281.     global dirName
  282.  
  283. set w .filereq
  284. catch {destroy $w}
  285.  
  286. toplevel $w -bg #cccccccccccc
  287. wm title $w "File Request for df$drive:" 
  288. wm iconname $w "File Request"
  289.  
  290. frame $w.buttons -bg #cccccccccccc 
  291. pack  $w.buttons -side bottom -expand y -fill x -pady 2m
  292. button $w.buttons.dismiss -text Cancel -relief groove -command "destroy $w" -bg #cccccccccccc
  293. pack $w.buttons.dismiss -side left -expand 1
  294.  
  295. label $w.dirLabel -text "Directory:" -bg #cccccccccccc
  296. set dirName ../Disks
  297. entry $w.dirName -width 30 -relief groove -textvariable dirName
  298. bind $w.dirName <Return> "loadDir $w"
  299. label $w.fileLabel -text "Double-Click to select file:" -bg #cccccccccccc
  300. frame $w.f
  301. pack $w.dirLabel $w.dirName $w.fileLabel $w.f -side top -anchor w
  302.  
  303. listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
  304. scrollbar $w.f.scroll -command "$w.f.list yview"
  305. pack $w.f.list $w.f.scroll -side left -fill y -expand 1
  306. bind $w.f.list <Double-1> "loadFile $w %x %y $drive" 
  307.  
  308. catch {image delete image2a}
  309.  $w.f.list delete 0 end
  310.     foreach i [lsort [glob $dirName/*]] {
  311.     $w.f.list insert end [file tail $i]
  312.     }
  313. }
  314.